unit uSBDUnit_Model;
interface
uses Classes, uSBDUnit_Types, uSBD_ServiceProvider;

type

INonFailMessage = interface
  ['{02A9D9DA-F073-4076-B41A-431390489A74}']
    function Kind: TNonFailMessageKind;
    function Stamp: TDateTime;
    function Msg: string;
  end;
TNonFailMessageArray = TArray<INonFailMessage>;

ITestNode = interface
    {$REGION 'Property accessors'}
  ['{053A5520-9210-413E-BE1A-E70E228A3A52}']
    function  GetExecResult: TExecutionResult;
    function  GetEnabled: boolean;
    procedure SetEnabled( Value: boolean);
    function  GetTernaryChecked: TTernary;
    function  GetStatus: TTestStatus;
    function  GetName: string;
    function  GetKind: TNodeKind;
    function  GetExecutionStartTime: TDateTime;
    function  GetExecutionEndTime: TDateTime;
    function  GetExecutionDuration: TDateTime;
    function  GetFailCount: integer;
    function  GetExecuteCount: integer;
    function  GetViewToken: TObject;
    procedure SetViewToken( Value: TObject);
    function  GetParent: ITestNode;
    function  GetChild( Idx: integer): ITestNode;
    function  GetCount: integer;
    function  GetLoadCount: integer;
    {$ENDREGION}
    property ExecutionResult: TExecutionResult  read GetExecResult;
    property Enabled: boolean             read GetEnabled write SetEnabled;
    property TernaryChecked: TTernary     read GetTernaryChecked;
    property Status: TTestStatus          read GetStatus;
    property Name: string                 read GetName;
    property Kind: TNodeKind              read GetKind;
    property ExecutionStartTime: TDateTime      read GetExecutionStartTime;
    property ExecutionEndTime: TDateTime        read GetExecutionEndTime;
    property ExecutionDuration: TDateTime       read GetExecutionDuration;
    property FailCount: integer                 read GetFailCount;
    property ExecuteCount: integer              read GetExecuteCount;
    property LoadCount: integer                 read GetLoadCount;
    property ViewToken: TObject                 read GetViewToken write SetViewToken;
    property Parent: ITestNode                  read GetParent;
    property Count: integer                     read GetCount;
    property Children[ Idx: integer]: ITestNode read GetChild; default;
  end;

ITestCaseNode = interface( ITestNode)
  ['{991CE815-C0BB-44B2-AD55-40ED07140C55}']
    {$REGION 'Property accessors'}
    function  GetFailMessage: string;
    function  GetFailStamp: TDateTime;
    function  GetNonFailMessages: TNonFailMessageArray;
    {$ENDREGION}
    property  FailStamp: TDateTime         read GetFailStamp;
    property  FailMessage: string          read GetFailMessage;
    property  NonFailMessages: TNonFailMessageArray    read GetNonFailMessages;
  end;

TCustomAttributeClass = class of TCustomAttribute;
ITestHarness = interface
  ['{0B456D7C-2A45-4C59-B5AF-592CC7254A74}']
    procedure Check  ( Condition: boolean; const Msg: string = '');
    procedure Warning( Condition: boolean; const Msg: string = '');
    procedure Info   ( const InfoMessage: string);

    procedure CheckFalse    ( Condition: Boolean; const Msg: string = '');
    procedure CheckEquals   ( Expected, Actual: Extended; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: Extended; Tolerance: Extended = 0.0; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: integer; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: cardinal; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: int64; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: uint64; const Msg: string = ''); overload;
    procedure CheckEquals   ( const Expected, Actual: string; const Msg: string = ''); overload;
    procedure CheckEquals   ( const Expected, Actual: RawByteString; const Msg: string = ''); overload;
    procedure CheckEquals   ( const Expected, Actual: AnsiString; const Msg: string = ''); overload;
    procedure CheckEqualsMem( expected, actual: pointer; size:longword; const Msg:string='');
    procedure CheckEquals   ( Expected, Actual: boolean; const Msg: string = ''); overload;
    procedure CheckNull     ( const Intft: IInterface; const Msg: string = ''); overload;
    procedure CheckNull     ( Obj: TObject; const Msg: string = ''); overload;
    procedure CheckSame     ( const Expected, Actual: IInterface; const Msg: string = ''); overload;
    procedure CheckSameIntf ( const Expected, Actual: IInterface; const CastIID: TGUID; const Msg: string = ''); overload;
    procedure CheckSame     ( Expected, Actual: TObject; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: TClass; const Msg: string = ''); overload;
    procedure CheckInherits ( Expected, Actual: TClass; const Msg: string = ''); overload;
    procedure CheckIs       ( Obj: TObject; Cls: TClass; const Msg: string = ''); overload;
    procedure CheckClassHasAttribute( Cls: TClass; Attrib: TCustomAttributeClass; const Msg: string = '');
    procedure CheckNotEquals   ( Expected, Actual: Extended; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: Extended; Tolerance: Extended = 0.0; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: integer; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: cardinal; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: int64; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: uint64; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( const Expected, Actual: string; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( const Expected, Actual: RawByteString; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( const Expected, Actual: AnsiString; const Msg: string = ''); overload;
    procedure CheckNotEqualsMem( expected, actual: pointer; size:longword; const Msg:string='');
    procedure CheckNotEquals   ( Expected, Actual: boolean; const Msg: string = ''); overload;
    procedure CheckNotNull     ( const Intft: IInterface; const Msg: string = ''); overload;
    procedure CheckNotNull     ( Obj: TObject; const Msg: string = ''); overload;
    procedure CheckNotSame     ( const Expected, Actual: IInterface; const Msg: string = ''); overload;
    procedure CheckNotSameIntf ( const Expected, Actual: IInterface; const CastIID: TGUID; const Msg: string = ''); overload;
    procedure CheckNotSame     ( Expected, Actual: TObject; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: TClass; const Msg: string = ''); overload;
    procedure CheckNotInherits ( Expected, Actual: TClass; const Msg: string = ''); overload;
    procedure CheckNotIs       ( Obj: TObject; Cls: TClass; const Msg: string = ''); overload;
    procedure CheckXMLisWellFormed( const sXML: utf8string; const Msg: string);
  end;


TestSuite = class( TCustomAttribute)
  public
    Name: string;
    constructor Create( const Name1: string);
  end;

TestCase = class( TCustomAttribute)
  end;

ITestSuite = interface
  ['{B721B527-F2C7-4D77-AE6C-DBECE1F84F9A}']
    procedure SetHarness( const Harness1: ITestHarness);
    procedure Setup;
    procedure Teardown;
  end;

TTestSuite = class( TInterfacedPersistent)
  protected
    FHarness: ITestHarness;

    procedure Setup;         virtual;
    procedure Teardown;      virtual;

    procedure Check  ( Condition: boolean; const Msg: string = '');
    procedure Warning( Condition: boolean; const Msg: string = '');
    procedure Info   ( const InfoMessage: string);
    procedure CheckFalse    ( Condition: Boolean; const Msg: string = '');

    procedure CheckEquals   ( Expected, Actual: Extended; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: Extended; Tolerance: Extended = 0.0; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: integer; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: cardinal; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: int64; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: uint64; const Msg: string = ''); overload;
    procedure CheckEquals   ( const Expected, Actual: string; const Msg: string = ''); overload;
    procedure CheckEquals   ( const Expected, Actual: RawByteString; const Msg: string = ''); overload;
    procedure CheckEquals   ( const Expected, Actual: AnsiString; const Msg: string = ''); overload;
    procedure CheckEqualsMem( expected, actual: pointer; size:longword; const Msg:string='');
    procedure CheckEquals   ( Expected, Actual: boolean; const Msg: string = ''); overload;
    procedure CheckNull     ( const Intft: IInterface; const Msg: string = ''); overload;
    procedure CheckNull     ( Obj: TObject; const Msg: string = ''); overload;
    procedure CheckSame     ( const Expected, Actual: IInterface; const Msg: string = ''); overload;
    procedure CheckSameIntf ( const Expected, Actual: IInterface; const CastIID: TGUID; const Msg: string = ''); overload;
    procedure CheckSame     ( Expected, Actual: TObject; const Msg: string = ''); overload;
    procedure CheckEquals   ( Expected, Actual: TClass; const Msg: string = ''); overload;
    procedure CheckInherits ( Expected, Actual: TClass; const Msg: string = ''); overload;
    procedure CheckIs       ( Obj: TObject; Cls: TClass; const Msg: string = ''); overload;
    procedure CheckClassHasAttribute( Cls: TClass; Attrib: TCustomAttributeClass; const Msg: string = '');

    procedure CheckNotEquals   ( Expected, Actual: Extended; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: Extended; Tolerance: Extended = 0.0; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: integer; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: cardinal; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: int64; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: uint64; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( const Expected, Actual: string; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( const Expected, Actual: RawByteString; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( const Expected, Actual: AnsiString; const Msg: string = ''); overload;
    procedure CheckNotEqualsMem( expected, actual: pointer; size:longword; const Msg:string='');
    procedure CheckNotEquals   ( Expected, Actual: boolean; const Msg: string = ''); overload;
    procedure CheckNotNull     ( const Intft: IInterface; const Msg: string = ''); overload;
    procedure CheckNotNull     ( Obj: TObject; const Msg: string = ''); overload;
    procedure CheckNotSame     ( const Expected, Actual: IInterface; const Msg: string = ''); overload;
    procedure CheckNotSameIntf ( const Expected, Actual: IInterface; const CastIID: TGUID; const Msg: string = ''); overload;
    procedure CheckNotSame     ( Expected, Actual: TObject; const Msg: string = ''); overload;
    procedure CheckNotEquals   ( Expected, Actual: TClass; const Msg: string = ''); overload;
    procedure CheckNotInherits ( Expected, Actual: TClass; const Msg: string = ''); overload;
    procedure CheckNotIs       ( Obj: TObject; Cls: TClass; const Msg: string = ''); overload;
    procedure CheckXMLisWellFormed( const sXML: utf8string; const Msg: string);
  end;



ITestEngine = interface
  ['{43026311-E7D1-485C-9059-5A74255840E7}']
    function  GetStopOnFirstFail: boolean;
    procedure SetStopOnFirstFail( Value: boolean);

    procedure StartUp;
    procedure ShutDown;
    function  Can_ShutDown: boolean;
    function  Root: ITestNode;
    procedure Run;
    function  Can_Run: boolean;
    procedure Clear;
    function  Can_Clear: boolean;
    procedure Abort;
    function  Can_Abort: boolean;
    function  isRunning: boolean;
    procedure RegisterTestSuite( Cls: TClass);
    procedure SetControllerClient( const ClientCallback1: IControllerFeedback);
    function  Started: boolean;

    property  StopOnFirstFail: boolean    read  GetStopOnFirstFail
                                          write SetStopOnFirstFail;
  end;

SuiteConstructor = class( TSBDUnit_BaseAttribute) end;

TTestModulationEvent = (evTestCaseConstruction, evSetup, evMainExecute, evTeardown);
TTestModulationEventSet = set of TTestModulationEvent;

RModulationNobsToTweek = record
     FRepeatCount: integer;
     FdoLeakageTest: boolean;
   end;

TTestModulator = class abstract( TSBDUnit_BaseAttribute)
  public
    function  InterestedIn: TTestModulationEventSet;            virtual;
    procedure ModulateTest( Event: TTestModulationEvent;
                            var Nobs: RModulationNobsToTweek);  virtual; abstract;
    function  AnnotationDisplayName: string;                    virtual; abstract;
  end;

Repeated = class sealed( TTestModulator)
  public
    FRepeatCount: integer;
    constructor Create( RepeatCount1: integer);
    function  InterestedIn: TTestModulationEventSet;            override;
    procedure ModulateTest( Event: TTestModulationEvent;
                            var Nobs: RModulationNobsToTweek);  override;
    function  AnnotationDisplayName: string;                    override;
  end;

CheckMemory = class sealed( TTestModulator)
  public
    constructor Create;
    function  InterestedIn: TTestModulationEventSet;            override;
    procedure ModulateTest( Event: TTestModulationEvent;
                            var Nobs: RModulationNobsToTweek);  override;
    function  AnnotationDisplayName: string;                    override;
  end;

resourcestring
  ExpectedErrorMessage    = 'Expected %2:s %0:s, but got %1:s .';
  ExpectedNotErrorMessage = 'Expected different to %1:s %0:s, but got the same.';

implementation




uses SysUtils;
{ TTestSuite }

procedure TTestSuite.Check( Condition: boolean; const Msg: string = '');
begin
if assigned( FHarness) then
  FHarness.Check( Condition, Msg)
end;

procedure TTestSuite.CheckClassHasAttribute(
  Cls: TClass; Attrib: TCustomAttributeClass; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckClassHasAttribute( Cls, Attrib, Msg)
end;

procedure TTestSuite.CheckEquals( const Expected, Actual, Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals( Expected, Actual: uint64; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals( const Expected, Actual: AnsiString;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals( const Expected, Actual: RawByteString;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals(Expected, Actual: int64; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals(Expected, Actual, Tolerance: Extended;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Tolerance, Msg)
end;

procedure TTestSuite.CheckEquals(Expected, Actual: Extended; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals(Expected, Actual: cardinal; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals(Expected, Actual: integer; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals(Expected, Actual: boolean; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckEquals(Expected, Actual: TClass; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEquals( Expected, Actual, Msg)
end;


procedure TTestSuite.CheckEqualsMem( expected, actual: pointer; size: longword;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckEqualsMem( Expected, Actual, Size, Msg)
end;

procedure TTestSuite.CheckFalse( Condition: Boolean; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckFalse( Condition, Msg)
end;

procedure TTestSuite.CheckInherits( Expected, Actual: TClass; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckInherits( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckIs( Obj: TObject; Cls: TClass; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckIs( Obj, Cls)
end;

procedure TTestSuite.CheckNotEquals( const Expected, Actual: AnsiString;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(Expected, Actual: boolean;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(const Expected, Actual: RawByteString;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(Expected, Actual: int64; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(Expected, Actual: uint64;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(const Expected, Actual, Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(Expected, Actual: Extended;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(Expected, Actual: integer;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(Expected, Actual, Tolerance: Extended;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Tolerance, Msg)
end;

procedure TTestSuite.CheckNotEquals(Expected, Actual: TClass;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotEquals(
  Expected, Actual: cardinal; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEquals( Expected, Actual, Msg)
end;


procedure TTestSuite.CheckNotEqualsMem( Expected, actual: pointer;
  size: longword; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotEqualsMem( Expected, Actual, Size, Msg)
end;

procedure TTestSuite.CheckNotInherits( Expected, Actual: TClass;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotInherits( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotIs( Obj: TObject; Cls: TClass; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotIs( Obj, Cls, Msg)
end;

procedure TTestSuite.CheckNotNull(const Intft: IInterface; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotNull( Intft, Msg)
end;

procedure TTestSuite.CheckNotNull( Obj: TObject; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotNull( Obj, Msg)
end;

procedure TTestSuite.CheckNotSame( const Expected, Actual: IInterface;
  const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotSame( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotSame( Expected, Actual: TObject; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotSame( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckNotSameIntf( const Expected, Actual: IInterface;
  const CastIID: TGUID; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNotSameIntf( Expected, Actual, CastIID, Msg)
end;

procedure TTestSuite.CheckNull( Obj: TObject; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNull( Obj, Msg)
end;

procedure TTestSuite.CheckNull( const Intft: IInterface; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckNull( Intft, Msg)
end;

procedure TTestSuite.CheckSame(
  const Expected, Actual: IInterface; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckSame( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckSame( Expected, Actual: TObject; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckSame( Expected, Actual, Msg)
end;

procedure TTestSuite.CheckSameIntf(
  const Expected, Actual: IInterface; const CastIID: TGUID; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckSameIntf( Expected, Actual, CastIID, Msg)
end;

procedure TTestSuite.CheckXMLisWellFormed(
  const sXML: utf8string; const Msg: string);
begin
if assigned( FHarness) then
  FHarness.CheckXMLisWellFormed( sXML, Msg)
end;

procedure TTestSuite.Info( const InfoMessage: string);
begin
if assigned( FHarness) then
  FHarness.Info( InfoMessage)
end;

procedure TTestSuite.Setup;
begin
end;


procedure TTestSuite.Teardown;
begin
end;

procedure TTestSuite.Warning( Condition: boolean; const Msg: string = '');
begin
if assigned( FHarness) then
  FHarness.Warning( Condition, Msg)
end;

constructor TestSuite.Create( const Name1: string);
begin
Name := Name1
end;



{ TTestModulator }

function TTestModulator.InterestedIn: TTestModulationEventSet;
var
  j: TTestModulationEvent;
begin
result := [];
for j := Low( TTestModulationEvent) to High( TTestModulationEvent) do
  Include( result, j)
end;

{ Repeated }

function Repeated.AnnotationDisplayName: string;
begin
result := Format( 'Repeated(%d)', [FRepeatCount])
end;

constructor Repeated.Create( RepeatCount1: integer);
begin
FRepeatCount := RepeatCount1;
if FRepeatCount < 2 then
   FRepeatCount := 2
end;


function Repeated.InterestedIn: TTestModulationEventSet;
begin
result := [evTestCaseConstruction]
end;

procedure Repeated.ModulateTest(
  Event: TTestModulationEvent; var Nobs: RModulationNobsToTweek);
begin
Nobs.FRepeatCount := FRepeatCount
end;

{ CheckMemory }

constructor CheckMemory.Create;
begin
end;

function CheckMemory.AnnotationDisplayName: string;
begin
result := 'Memory check'
end;

function CheckMemory.InterestedIn: TTestModulationEventSet;
begin
result := [evMainExecute]
end;

procedure CheckMemory.ModulateTest(
  Event: TTestModulationEvent; var Nobs: RModulationNobsToTweek);
begin
Nobs.FdoLeakageTest := True
end;

end.
